home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / general / hdf / unix / hdf3_2r2.lha / HDF3.2r2 / test / tsdntf.f < prev    next >
Encoding:
Text File  |  1992-10-28  |  7.8 KB  |  289 lines
  1. C***************************************************************************
  2. C
  3. C
  4. C                         NCSA HDF version 3.2r2
  5. C                            October 30, 1992
  6. C
  7. C NCSA HDF Version 3.2 source code and documentation are in the public
  8. C domain.  Specifically, we give to the public domain all rights for future
  9. C licensing of the source code, all resale rights, and all publishing rights.
  10. C
  11. C We ask, but do not require, that the following message be included in all
  12. C derived works:
  13. C
  14. C Portions developed at the National Center for Supercomputing Applications at
  15. C the University of Illinois at Urbana-Champaign, in collaboration with the
  16. C Information Technology Institute of Singapore.
  17. C
  18. C THE UNIVERSITY OF ILLINOIS GIVES NO WARRANTY, EXPRESSED OR IMPLIED, FOR THE
  19. C SOFTWARE AND/OR DOCUMENTATION PROVIDED, INCLUDING, WITHOUT LIMITATION,
  20. C WARRANTY OF MERCHANTABILITY AND WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE
  21. C
  22. C***************************************************************************
  23.  
  24. C
  25. C $Header: /hdf/hdf/v3.2r2/test/RCS/tsdntf.f,v 1.5 1992/06/30 20:34:24 chouck beta koziol $
  26. C
  27. C $Log: tsdntf.f,v $
  28. c Revision 1.5  1992/06/30  20:34:24  chouck
  29. c Fortran character passing problems were making the int8 tests
  30. c fail.  Change int8 variables to 'byte' for VMS
  31. c
  32. c Revision 1.4  1992/06/26  20:44:33  chouck
  33. c Oops, filename change made lines too long
  34. c
  35. c Revision 1.2  1992/05/28  17:31:32  chouck
  36. c Changed output file names
  37. c
  38. c Revision 1.1  1992/04/27  17:28:04  sxu
  39. c Initial revision
  40. c
  41. c Revision 1.1  1992/02/29  19:32:51  mfolk
  42. c Initial revision
  43. c
  44. C
  45.       program tdfsd_ntF
  46. C
  47. C
  48. C  Program to test writing SDSs with different types of data.
  49. C
  50. C  Input file:  none
  51. C  Output files:  o.hdf.1, o.hdf.2, ... o.hdf.5
  52. C
  53. C  **** VMS users ****
  54. C
  55. C  VMS has a special way of handling the passsing of character
  56. C   strings between C and FORTRAN.  For these tests to work 
  57. C   correctly, you must change the definition of i8 and ti8
  58. C   to be 'byte' not 'character'  You will also need to remove
  59. C   a couple of calls to char().  If you search on the string 
  60. C   VMS you should be able to find all of the necessary changes.
  61. C
  62.       integer dspdata, dsgdata, dsadata, dssdims, dssnt
  63.  
  64.       real*8 f64(10,10), tf64(10,10)
  65.       real*4 f32(10,10), tf32(10,10)
  66.       integer*2 i16(10,10), ti16(10,10)
  67.       integer*4 i32(10,10), ti32(10,10)
  68.  
  69. C  Change these to be of type 'byte' for VMS
  70. C      byte      i8(10,10), ti8(10,10)
  71.       character i8(10,10), ti8(10,10)
  72.  
  73.       
  74.       integer i, j, err, err1, err2
  75.       integer rank
  76.       integer dims(2)
  77.       integer number_failed
  78.       integer DFNT_FLOAT64, DFNT_FLOAT32, DFNT_INT8
  79.       integer DFNT_INT16, DFNT_INT32
  80.   
  81.       number_failed = 0
  82.       DFNT_FLOAT64 = 6
  83.       DFNT_FLOAT32 = 5
  84.       DFNT_INT8 = 20
  85.       DFNT_INT16 = 22
  86.       DFNT_INT32 = 24
  87.       rank = 2
  88.       dims(1) = 10
  89.       dims(2) = 10
  90.   
  91.       print *, 'Creating arrays...'
  92.   
  93.       do 110 i=1,10
  94.           do 100 j=1,10
  95.             f64(i,j) = (i * 10) + j
  96.           f32(i,j) = (i * 10) + j
  97. C  Use the following line for VMS
  98. C            i8(i,j) =  (i * 10) + j
  99.            i8(i,j) = char( (i * 10) + j )
  100.           i16(i,j) = (i * 10) + j
  101.           i32(i,j) = (i * 10) + j
  102.   100     continue
  103.   110 continue
  104.   
  105.       err = dssdims(rank, dims)
  106.   
  107. C  individual files 
  108.       print *,'Testing arrays in individual files...'
  109.   
  110.       err = dssnt(DFNT_FLOAT64)
  111.       err1 = dspdata('o1.hdf', rank, dims, f64)
  112.       err2 = dsgdata('o1.hdf', rank, dims, tf64)
  113.       print *,'Write: ', err1, '    Read: ', err2
  114.       err = 0
  115.       do 160 i=1,10
  116.           do 150 j=1,10
  117.           if (f64(i,j).ne.tf64(i,j)) err = 1
  118.           tf64(i,j) = 0.0
  119.   150     continue
  120.   160 continue
  121.  
  122.       call err_check(err, number_failed, 'float64')
  123.  
  124.       err = dssnt(DFNT_FLOAT32)
  125.       err1 = dspdata('o2.hdf', rank, dims, f32)
  126.       err2 = dsgdata('o2.hdf', rank, dims, tf32)
  127.       print *,'Write: ', err1, '    Read: ', err2
  128.       err = 0
  129.       do 210 i=1,10
  130.           do 200 j=1,10
  131.           if (f32(i,j).ne.tf32(i,j)) err = 1
  132.           tf32(i,j) = 0.0
  133.   200     continue
  134.   210 continue
  135.  
  136.       call err_check(err, number_failed, 'float32')
  137.  
  138.       err = dssnt(DFNT_INT8)
  139.       err1 = dspdata('o3.hdf', rank, dims, i8)
  140.       err2 = dsgdata('o3.hdf', rank, dims, ti8)
  141.       print *,'Write: ', err1, '    Read: ', err2
  142.       err = 0
  143.       do 310 i=1,10
  144.           do 300 j=1,10
  145.           if (i8(i,j).ne.ti8(i,j)) err = 1
  146. C Use the following line for VMS
  147. C           ti8(i,j) = 0
  148.           ti8(i,j) = char(0)
  149.   300     continue
  150.   310 continue
  151.  
  152.       call err_check(err, number_failed, 'int8')
  153.  
  154.       err = dssnt(DFNT_INT16)
  155.       err1 = dspdata('o4.hdf', rank, dims, i16)
  156.       err2 = dsgdata('o4.hdf', rank, dims, ti16)
  157.       print *,'Write: ', err1, '    Read: ', err2
  158.       err = 0
  159.       do 410 i=1,10
  160.           do 400 j=1,10
  161.            if (i16(i,j).ne.ti16(i,j)) err = 1
  162.           ti16(i,j) = 0
  163.   400     continue
  164.   410 continue
  165.  
  166.       call err_check(err, number_failed, 'int16')
  167.  
  168.       err = dssnt(DFNT_INT32)
  169.       err1 = dspdata('o5.hdf', rank, dims, i32)
  170.       err2 = dsgdata('o5.hdf', rank, dims, ti32)
  171.       print *,'Write: ', err1, '    Read: ', err2
  172.       err = 0
  173.       do 510 i=1,10
  174.           do 500 j=1,10
  175.           if (i32(i,j).ne.ti32(i,j)) err = 1
  176.           ti32(i,j) = 0
  177.   500     continue
  178.   510 continue
  179.  
  180.       call err_check(err, number_failed, 'int32')
  181.  
  182.  
  183. C 
  184.       print *, 'Writing arrays to single file.'
  185.       print *, 'Error values: '
  186. C
  187.       err = dssnt(DFNT_FLOAT64)
  188.       print *,'Add float64 ret: ',dsadata('ntf.hdf',rank,dims,f64)
  189.  
  190.       err = dssnt(DFNT_FLOAT32)
  191.       print *,'Add float32 ret: ',dsadata('ntf.hdf',rank,dims,f32)
  192.  
  193.       err = dssnt(DFNT_INT8)
  194.       print *, 'Add int8 ret: ', dsadata('ntf.hdf', rank, dims, i8)
  195.  
  196.       err = dssnt(DFNT_INT16)
  197.       print *, 'Add int16 ret: ', dsadata('ntf.hdf', rank, dims, i16)
  198.  
  199.       err = dssnt(DFNT_INT32)
  200.       print *, 'Add int32 ret: ', dsadata('ntf.hdf', rank, dims, i32)
  201.  
  202. C 
  203.       print *, 'Reading arrays from single file... '
  204.       print *, 'Error values: '
  205. C
  206.       print *, 'Get f64 ret: ', dsgdata('ntf.hdf', rank, dims, tf64)
  207.       print *, 'Get f32 ret: ', dsgdata('ntf.hdf', rank, dims, tf32)
  208.       print *, 'Get int8 ret: ', dsgdata('ntf.hdf', rank, dims, ti8)
  209.       print *, 'Get int16 ret: ', dsgdata('ntf.hdf', rank, dims, ti16)
  210.       print *, 'Get int32 ret: ', dsgdata('ntf.hdf', rank, dims, ti32)
  211.  
  212. C 
  213.       print *, 'Checking arrays from single file...\n\n'
  214.  
  215.       err = 0
  216.       do 910 i=1,10
  217.          do 900 j=1,10
  218.            if (f64(i,j) .ne. tf64(i,j)) err = 1
  219.   900    continue
  220.   910 continue
  221.  
  222.       call err_check(err, number_failed, 'float64')
  223. C 
  224.  
  225.       err = 0
  226.       do 1010 i=1,10
  227.          do 1000 j=1,10
  228.            if (f32(i,j) .ne. tf32(i,j)) err = 1
  229.  1000    continue
  230.  1010 continue
  231.  
  232.       call err_check(err, number_failed, 'float32')
  233. C 
  234.       err = 0
  235.       do 1110 i=1,10
  236.          do 1100 j=1,10
  237.            if (i8(i,j) .ne. ti8(i,j)) err = 1
  238.  1100    continue
  239.  1110 continue
  240.  
  241.       call err_check(err, number_failed, 'int8')
  242. C 
  243.       err = 0
  244.       do 1210 i=1,10
  245.          do 1200 j=1,10
  246.            if (i16(i,j) .ne. ti16(i,j)) err = 1
  247.  1200    continue
  248.  1210 continue
  249.  
  250.       call err_check(err, number_failed, 'int16')
  251. C 
  252.       err = 0
  253.       do 1310 i=1,10
  254.          do 1300 j=1,10
  255.            if (i32(i,j) .ne. ti32(i,j)) err = 1
  256.  1300    continue
  257.  1310 continue
  258.  
  259.       call err_check(err, number_failed, 'int32')
  260. C 
  261.       print *
  262.       if (number_failed .gt. 0 ) then
  263.       print *,'        >>> ', number_failed, ' TESTS FAILED <<<'
  264.       else
  265.       print *,'        >>> ALL TESTS PASSED <<<'
  266.       endif
  267.       print *
  268.       print *
  269.  
  270.       stop
  271.       end  
  272.   
  273. C
  274. C
  275.       subroutine err_check(err, num_fail, type)
  276.       integer err, num_fail
  277.       character*(*) type
  278.  
  279.       if (err .eq. 1) then 
  280.       print *,'>>> Test failed for ',type, ' array.'
  281.         num_fail = num_fail+1
  282.       else
  283.       print *,'Test passed for ', type, ' array.'
  284.       endif
  285.  
  286.       return
  287.       end
  288.  
  289.